home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / General / ViewIt™ 2.24 Shareware / FORTRAN Demo Projects / LS Fortran 3.3 Demos / fDemoLF.f < prev    next >
Text File  |  1993-09-20  |  4KB  |  135 lines
  1. C NOTE: Read the "MPW Fortrans" section of "About Compilers"
  2. C before compiling LF programs that use FaceWare modules.
  3.  
  4. C FaceIt 2.2 Demonstration Program
  5. C ©FaceWare 1989-93.  All Rights Reserved.
  6. C1 - run program to see on-line comments
  7.  
  8. !!M Inlines.f
  9. C2
  10. !!I FaceProcLF.inc
  11.  
  12.       PROGRAM fDemoLF
  13.     implicit none
  14. C NOTE: If you use the "!!G" directive for precompiled globals, add
  15. C our FaceStorLF.inc globals to yours and then remove following line
  16.     include 'FaceStorLF.inc'
  17.       record /FaceRec/ fRec
  18.       common/FaceStuff/fRec
  19.     integer*1 keys(16)
  20.     integer*2 i,mode
  21.     integer*4 oldCount,newCount
  22.     character*256 fileName
  23. C3
  24.       fRec.uName = 'fDemo.Rsrc'
  25. C4
  26.       call FaceIt(0,DoInit,3,0,0,0)
  27. C5
  28.     call FaceIt(0,NewWnd,1010,1,0,0)
  29.     call FaceIt(0,NewWnd,1020,1,0,0)
  30. C6
  31.     call FaceIt(0,NewWnd,1030,1,0,0)
  32. C7
  33.     call FaceIt(0,NewWnd,1040,2,0,0)
  34. C8
  35.       do while (.true.)
  36.         call FaceIt(0,DoLoop,0,0,0,0)
  37. C9
  38.         if (fRec.uMenuID = 101) then
  39. C10
  40.         if (fRec.uMenuItem = 1) then
  41.           fRec.uString = 'Demonstration of the use of FaceIt'
  42.      +//char(13)//'to support program-wide features.'
  43.           call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
  44.         end if
  45. C11
  46.       else if (fRec.uMenuID = 102) then
  47.         if (fRec.uMenuItem = 6) then
  48.           call FaceIt(0,GetWVC,1010,0,0,0)
  49.           call FaceIt(0,SavWnd,1010,0,0,0)
  50.           call FaceIt(0,GetWVC,1020,0,0,0)
  51.           call FaceIt(0,SavWnd,1020,0,0,0)
  52.           call FaceIt(0,GetWVC,1040,0,0,0)
  53.           call FaceIt(0,SavWnd,1040,0,0,0)
  54.         end if
  55. C12
  56.       else if ((fRec.uMenuID >= 105).and.(fRec.uMenuID <= 1040)) then
  57.         if (fRec.uMenuItem = 1) then
  58.           call SysBeep(%val(int2(5)))
  59.         else if (fRec.uMenuItem = 2) then
  60.           call SysBeep(%val(int2(5)))
  61.           call SysBeep(%val(int2(5)))
  62.         else if (fRec.uMenuItem = 3) then
  63.           call SysBeep(%val(int2(5)))
  64.           call SysBeep(%val(int2(5)))
  65.           call SysBeep(%val(int2(5)))
  66. C13
  67.         else if (fRec.uMenuItem = 4) then
  68.           call FaceIt(0,GetCtl,1030,0,1,4)
  69.           call FaceIt(0,PopMen,107,fRec.cRect(1)-9,fRec.cRect(2)-10,0)
  70. C14
  71.         else if (fRec.uMenuItem = 8) then
  72. C15
  73.         call FaceIt(0,ShoAlt,1010,0,1,1)
  74.         mode = fRec.uResult
  75.         oldCount = 0
  76.         if (mode > 1) then
  77.           do while (.true.)
  78. C16
  79.             newCount = TickCount
  80.             if (newCount - oldCount > 180) then
  81.               call SysBeep(%val(int2(5)))
  82.             oldCount = newCount
  83.             end if
  84. C17
  85.             if (mode = 2) then
  86.               if (GetNextEvent(%val(int2(-1)),fRec.fEvent) <> 0) then
  87.               if (fRec.fEvent(1) = 5) then
  88.                 leave
  89.               else
  90.                 call FaceIt(0,DoEvnt,0,0,0,0)
  91.               end if
  92.             end if
  93.             end if
  94. C18
  95.             if (mode = 3) then
  96.               call GetKeys(keys)
  97.             if ((BitTst(keys,%val(61))<>0).and.(BitTst(keys,%val(48))<>0)) then
  98.               call FlushEvents(%val(int2(62)),%val(int2(0)))
  99.               leave
  100.             end if
  101.             end if
  102.           end do
  103.         end if
  104.         end if
  105. C19
  106.       else if (fRec.uMenuID = 1100) then
  107.         if (fRec.uMenuItem = 2) then
  108.           if (fRec.fActiveWnd = 0) then
  109.           fRec.uString = 'No Window'
  110.         else if (fRec.fActiveID <> 1200) then
  111.           fRec.uString = 'Non-ViewIt Window'
  112.         else if (fRec.fActiveResID = 1204) then
  113.           fRec.uString = 'Help Window'
  114.         else if (fRec.fActiveResID = 1010) then
  115.           fRec.uString = 'Editor Window'
  116.         else if (fRec.fActiveResID = 1020) then
  117.           fRec.uString = 'Clipboard Window'
  118.         else if (fRec.fActiveResID = 1030) then
  119.           fRec.uString = 'Beeps Window'
  120.         end if
  121.         call FaceIt(0,SetItm2,105,10,3,0)
  122. C20
  123.         else if (fRec.uMenuItem = 512) then
  124.           if ((fRec.uString = 'TEXT').and.(fRec.uResult = 1)) then
  125.           fileName = fRec.uName
  126.           call FaceIt(0,GetCtl,1010,0,1,1)
  127.           fRec.uName = fileName
  128.           call FaceIt(fRec.cControl,1551,0,1,0,0) !OpnCTxt
  129.         end if
  130.         end if
  131.       end if
  132.       end do
  133.  
  134.       end
  135.